問題の説明
コードは 2 つの製品で動作しますが、3 番目の製品コードを追加すると、データが取得されますが、3 番目の製品だけに保存されません。どうしたの？ (Code works with two products but when I add a third product code grabs data but doesn't save it only for third product. What's wrong with it?)
このコードは、石油とガスに対しても機能します。洗練されたデータを見つけて取り込みます。実行中は現在の価格ワークシートで確認できますが、実行が終了すると、洗練されたデータが削除され、他のシートには洗練されたデータのみが入力されません。オイルのすべてのコード ビットをコピーし、オイルという単語を精製済みに置き換えました。
Sub Prices()
Dim asOfDate As Date
Dim i, c, r As Integer
Dim break As Integer
Dim wf As WorksheetFunction
ws_currentprices.Activate
'Copy date from summary ws to pop asofdate
Cells(ASOFDATE_ROW, BUCKET_COL) = ws_summary.Cells(1, 6)
If IsEmpty(Cells(ASOFDATE_ROW, BUCKET_COL)) Then
asOfDate = Date
Else
asOfDate = Cells(ASOFDATE_ROW, BUCKET_COL)
End If
'Setting to manual calculation must happen after asofdate has been populated
Application.Calculation = xlManual
'Clear all data and headers from the current prices ws
Range(Cells(STATUS_ROW, FIRSTDATA_COL), Cells(110, 50)).ClearContents
Set wf = Application.WorksheetFunction
'Build arraylist of gas markets
Dim gasArray As Object
Set gasArray = CreateObject("System.Collections.ArrayList")
i = 1
Do Until (IsEmpty(ws_gasmarkets.Cells(i, 4)))
If StrComp(ws_gasmarkets.Cells(i, 4), "Yes", vbTextCompare) = 0 Then gasArray.Add ws_gasmarkets.Cells(i, 2).Value
i = i + 1
Loop
'Process arraylist of gas markets
c = FIRSTDATA_COL
For i = 0 To gasArray.Count ‑ 1
Days = 0
Do Until Month(wf.WorkDay(asOfDate, Days)) <> Month(asOfDate)
Cells(COMMODITY_ROW, c) = gasArray(i)
Cells(ASOFDATE_ROW, c) = CDate(wf.WorkDay(asOfDate, Days))
Cells(DATASOURCE_ROW, c) = "Official"
Cells(MARKETTYPE_ROW, c) = "Gas"
break = c ‑ 1
c = c + 1
Days = Days ‑ 1
Loop
Cells(COMMODITY_ROW, c) = gasArray(i)
Cells(ASOFDATE_ROW, c) = dhLastDayInMonth(DateSerial(Year(asOfDate), Month(asOfDate) ‑ 1, 1))
Cells(DATASOURCE_ROW, c) = "Official"
Cells(MARKETTYPE_ROW, c) = "Gas"
break = c ‑ 1
c = c + 1
Next
'Build arraylist of oil markets
Dim oilArray As Object
Set oilArray = CreateObject("System.Collections.ArrayList")
i = 1
Do Until (IsEmpty(ws_oilmarkets.Cells(i, 4)))
If StrComp(ws_oilmarkets.Cells(i, 4), "Yes", vbTextCompare) = 0 Then oilArray.Add ws_oilmarkets.Cells(i, 2).Value
i = i + 1
Loop
'Process arraylist of oil markets
For i = 0 To oilArray.Count ‑ 1
Days = 0
Do Until Month(wf.WorkDay(asOfDate, Days)) <> Month(asOfDate)
Cells(COMMODITY_ROW, c) = oilArray(i)
Cells(ASOFDATE_ROW, c) = CDate(wf.WorkDay(asOfDate, Days))
Cells(DATASOURCE_ROW, c) = "Official"
Cells(MARKETTYPE_ROW, c) = "Oil"
break = c ‑ 1
c = c + 1
Days = Days ‑ 1
Loop
Cells(COMMODITY_ROW, c) = oilArray(i)
Cells(ASOFDATE_ROW, c) = dhLastDayInMonth(DateSerial(Year(asOfDate), Month(asOfDate) ‑ 1, 1))
Cells(DATASOURCE_ROW, c) = "Official"
Cells(MARKETTYPE_ROW, c) = "Oil"
break = c ‑ 1
c = c + 1
Next
'Build arraylist of REFINED markets
Dim REFINEDArray As Object
Set REFINEDArray = CreateObject("System.Collections.ArrayList")
i = 1
Do Until (IsEmpty(ws_REFINEDmarkets.Cells(i, 4)))
If StrComp(ws_REFINEDmarkets.Cells(i, 4), "Yes", vbTextCompare) = 0 Then REFINEDArray.Add ws_REFINEDmarkets.Cells(i, 2).Value
i = i + 1
Loop
'Process arraylist of REFINED markets
For i = 0 To REFINEDArray.Count ‑ 1
Days = 0
Do Until Month(wf.WorkDay(asOfDate, Days)) <> Month(asOfDate)
Cells(COMMODITY_ROW, c) = REFINEDArray(i)
Cells(ASOFDATE_ROW, c) = CDate(wf.WorkDay(asOfDate, Days))
Cells(DATASOURCE_ROW, c) = "Official"
Cells(MARKETTYPE_ROW, c) = "REFINED"
break = c ‑ 1
c = c + 1
Days = Days ‑ 1
Loop
Cells(COMMODITY_ROW, c) = REFINEDArray(i)
Cells(ASOFDATE_ROW, c) = dhLastDayInMonth(DateSerial(Year(asOfDate), Month(asOfDate) ‑ 1, 1))
Cells(DATASOURCE_ROW, c) = "Official"
Cells(MARKETTYPE_ROW, c) = "Refined"
break = c ‑ 1
c = c + 1
Next
'Downloads current prices from Kiodex
DownloadCurrentPrices
'Remove invalid pricing columns
If (PricesCleanup) Then
'Setup GAS and OIL worksheets
REFINEDSetup
GasSetup
OilSetup
'Calculate GAS and OIL worksheets
ws_REFINED.Calculate
ws_oil.Calculate
ws_gas.Calculate
'Refresh and display summary worksheet
'ws_summary.Calculate
Calculate
ws_summary.Activate
Refresh
'Set data source value based on NYMEX ‑ Not Updated (0), Preliminary (1), or Updated (2)
c = FIRSTDATA_COL
ds = 0
gaschk = False
oilchk = False
REFINEDchk = False
Do Until (IsEmpty(ws_currentprices.Cells(COMMODITY_ROW, c)) Or (gaschk And oilchk And REFINEDchk))
If (StrComp(ws_currentprices.Cells(COMMODITY_ROW, c), "GD Henry Hub", vbTextCompare) And Not gaschk) Then
If (ws_currentprices.Cells(ASOFDATE_ROW, c) = ws_currentprices.Cells(ASOFDATE_ROW, BUCKET_COL)) Then
'Data for current date
If (StrComp(ws_currentprices.Cells(DATASOURCE_ROW, c), "Official", vbTextCompare) = 0) Then
'Data is official
ds = ds + 2
Else
'Data is global
ds = ds + 1
End If
Else
'Data for prior date
ds = ds + 0
End If
gaschk = True
End If
If (StrComp(ws_currentprices.Cells(COMMODITY_ROW, c), "NYMEX WTI", vbTextCompare) And Not oilchk) Then
If (ws_currentprices.Cells(ASOFDATE_ROW, c) = ws_currentprices.Cells(ASOFDATE_ROW, BUCKET_COL)) Then
'Data for current date
If (StrComp(ws_currentprices.Cells(DATASOURCE_ROW, c), "Official", vbTextCompare) = 0) Then
'Data is official
ds = ds + 2
Else
'Data is global
ds = ds + 1
End If
Else
'Data for prior date
ds = ds + 0
End If
oilchk = True
End If
'***REFINED addition***
If (StrComp(ws_currentprices.Cells(COMMODITY_ROW, c), "OPIS Ethane Mt Belv non TET", vbTextCompare) And Not REFINEDchk) Then
If (ws_currentprices.Cells(ASOFDATE_ROW, c) = ws_currentprices.Cells(ASOFDATE_ROW, BUCKET_COL)) Then
'Data for current date
If (StrComp(ws_currentprices.Cells(DATASOURCE_ROW, c), "Official", vbTextCompare) = 0) Then
'Data is official
ds = ds + 2
Else
'Data is global
ds = ds + 1
End If
Else
'Data for prior date
ds = ds + 0
End If
REFINEDchk = True
End If
c = c + 1
Loop
Select Case ds
Case Is >= 4
ws_summary.Range("SummaryDataSource") = "Updated"
Case Is > 0
ws_summary.Range("SummaryDataSource") = "Preliminary"
Case Else
ws_summary.Range("SummaryDataSource") = "Not Updated"
End Select
Else
ws_summary.Activate
ws_summary.Range("SummaryDataSource") = "Not Updated"
End If
'Set last updated date
ws_summary.Range("LastUpdatedDateTime") = Now
Application.Calculation = xlAutomatic
Application.ReferenceStyle = xlA1
'Update BOKF Pricing History
If Format(asOfDate, "m/d/yyyy") = Format(WorksheetFunction.WorkDay(WorksheetFunction.EoMonth(asOfDate, 0) + 1, ‑1), "m/d/yyyy") Then
Call UpdateBOKFPriceHistory(Format(DateSerial(Year(asOfDate), Month(asOfDate) + 1, 1), "mm/dd/yyyy"), False)
End If
End Sub
'This function checks the Current Prices tab for any columns that are duplicates of the day before or weekends and deletes the column
Function PricesCleanup() As Boolean
Dim r, c As Integer
Dim removeCount As Integer
Dim removeColumn As Boolean
Dim isGas, isOil, isREFINED As Boolean
c = FIRSTDATA_COL
removeCount = 0
Do Until IsEmpty(ws_currentprices.Cells(COMMODITY_ROW, c)) 'check every col of prices
'Start at the row of the first date and reset remove flag
r = FIRSTDATE_ROW
removeColumn = True
'Check each column, at least until there is a discrepancy between prices so we know it's not a holiday
Do Until ((r > 12 And IsEmpty(ws_currentprices.Cells(r, c))) Or r > 60 Or Not removeColumn)
'If the prices don't match, we know it's not a holiday
If (ws_currentprices.Cells(r, c) <> ws_currentprices.Cells(r, c + 1)) Then
'If the first row is empty or matches second row, it's likely due to near EoM index shifting and requires special handling
If r = FIRSTDATE_ROW Then
If IsEmpty(ws_currentprices.Cells(r, c)) Then
'Oil index swap
removeColumn = False
End If
If (ws_currentprices.Cells(r, c) = ws_currentprices.Cells(r + 1, c) And ws_currentprices.Cells(MARKETTYPE_ROW, c) = "Gas") Then
removeColumn = False
End If
'***Refined
If (ws_currentprices.Cells(r, c) = ws_currentprices.Cells(r + 1, c) And ws_currentprices.Cells(MARKETTYPE_ROW, c) = "REFINED") Then
removeColumn = False
End If
Else
'Not index related and no match, so don't remove column
removeColumn = False
End If
End If
r = r + 1
Loop
'Check for weekend dates or dates from prior month
If Weekday(ws_currentprices.Cells(ASOFDATE_ROW, c)) = 1 Or Weekday(ws_currentprices.Cells(ASOFDATE_ROW, c)) = 7 Or Month(ws_currentprices.Cells(ASOFDATE_ROW, c)) <> Month(ws_currentprices.Cells(ASOFDATE_ROW, BUCKET_COL)) Then
removeColumn = True
End If
'Remove column if flagged
If removeColumn Then
removeCount = removeCount + 1
ws_currentprices.Columns(c).EntireColumn.Delete
c = c ‑ 1
End If
'Copy up spot price
If Not IsEmpty(ws_currentprices.Cells(FIRSTDATE_ROW, c)) Then
ws_currentprices.Cells(SPOT_ROW, c) = ws_currentprices.Cells(FIRSTDATE_ROW, c)
ElseIf Not IsEmpty(ws_currentprices.Cells(FIRSTDATE_ROW + 1, c)) Then
ws_currentprices.Cells(SPOT_ROW, c) = ws_currentprices.Cells(FIRSTDATE_ROW + 1, c)
Else
ws_currentprices.Cells(SPOT_ROW, c) = ""
End If
c = c + 1
Loop
'Check if any columns are left and return bool value
isGas = False
isOil = False
isREFINED = False
c = FIRSTDATA_COL
Do Until IsEmpty(ws_currentprices.Cells(COMMODITY_ROW, c))
If (ws_currentprices.Cells(MARKETTYPE_ROW, c) = "Gas") Then
isGas = True
ElseIf (ws_currentprices.Cells(MARKETTYPE_ROW, c) = "Oil") Then
isOil = True
ElseIf (ws_currentprices.Cells(MARKETTYPE_ROW, c) = "Refined") Then
isREFINED = True
End If
c = c + 1
Loop
If (isGas And isOil And isREFINED) Then
PricesCleanup = True
Else
PricesCleanup = False
End If
End Function
Sub GasSetup()
Dim cpr, cpc, r, c, marketcount, marketstartrow As Integer
Dim index As Double
Const YEARMONTH_COL = 1
Const DATE_COL = 2
Const SPOT_COL = 3
Const markettype = "GAS"
ws_gas.UsedRange.ClearContents
cpc = FIRSTDATA_COL
marketcount = 0
'Loop through each column in currentprices looking for gas markets
Do Until (IsEmpty(ws_currentprices.Cells(COMMODITY_ROW, cpc)))
If StrComp(ws_currentprices.Cells(MARKETTYPE_ROW, cpc), markettype, vbTextCompare) = 0 Then
'This is a gas column
cpr = FIRSTDATE_ROW
c = 1
If StrComp(ws_currentprices.Cells(COMMODITY_ROW, cpc), ws_currentprices.Cells(COMMODITY_ROW, cpc ‑ 1), vbTextCompare) <> 0 Then
'Sort prior market data by date
If marketcount <> 0 Then
ws_gas.Range("A" & marketstartrow + 1 & ":FF" & r).Sort Key1:=ws_gas.Range("B" & marketstartrow + 1 & ":FF" & r), _
order1:=xlAscending, Header:=xlYes
End If
'Start each new market on row divisible by 30 + 1 to prevent any issues with summary table
marketstartrow = marketcount * 30 + 1
marketcount = marketcount + 1
r = marketstartrow
'Add labels for new market
ws_gas.Cells(r, YEARMONTH_COL) = ws_currentprices.Cells(COMMODITY_ROW, cpc)
ws_gas.Cells(r + 1, YEARMONTH_COL) = "YEARMONTH"
ws_gas.Cells(r + 1, DATE_COL) = "Date"
ws_gas.Cells(r + 1, SPOT_COL) = "Spot"
c = c + 3
For i = 0 To 59
ws_gas.Cells(r + 1, c + i) = i + 1
Next
r = r + 2
End If
'Populate date
ws_gas.Cells(r, DATE_COL) = ws_currentprices.Cells(ASOFDATE_ROW, cpc)
ws_gas.Cells(r, YEARMONTH_COL) = Year(ws_gas.Cells(r, DATE_COL)) & "." & Month(ws_gas.Cells(r, DATE_COL))
'Populate spot
ws_gas.Cells(r, SPOT_COL) = ws_currentprices.Cells(SPOT_ROW, cpc)
c = 4
'Populate row
Do Until cpr > 60 And IsEmpty(ws_currentprices.Cells(cpr, cpc))
ws_gas.Cells(r, c) = ws_currentprices.Cells(cpr, cpc)
cpr = cpr + 1
c = c + 1
Loop
r = r + 1
End If
cpc = cpc + 1
Loop
'Sort final market data by date
ws_gas.Range("A" & marketstartrow + 1 & ":FF" & r).Sort Key1:=ws_gas.Range("B" & marketstartrow + 1 & ":B" & r), _
order1:=xlAscending, Header:=xlYes
'Iterate through the Nymex data to update market index values
r = 2
index = 0
Do Until (IsEmpty(ws_gas.Cells(r, DATE_COL)))
If IsEmpty(ws_gas.Cells(r, DATE_COL + 2)) Then
'No value for current month, so take prior row value for index
Call UpdateIndexes(markettype, ws_gas.Cells(r ‑ 1, DATE_COL), ws_gas.Cells(r ‑ 1, DATE_COL + 2))
Exit Do
End If
r = r + 1
Loop
End Sub
Sub OilSetup()
Dim cpr, cpc, r, c, marketcount, marketstartrow As Integer
Dim index As Double
Const YEARMONTH_COL = 1
Const DATE_COL = 2
Const SPOT_COL = 3
Const markettype = "OIL"
ws_oil.UsedRange.ClearContents
cpc = FIRSTDATA_COL
marketcount = 0
marketstartrow = 0
'Loop through each column in currentprices looking for gas markets
Do Until (IsEmpty(ws_currentprices.Cells(COMMODITY_ROW, cpc)))
If StrComp(ws_currentprices.Cells(MARKETTYPE_ROW, cpc), markettype, vbTextCompare) = 0 Then
'This is a gas column
cpr = FIRSTDATE_ROW
c = 1
If StrComp(ws_currentprices.Cells(COMMODITY_ROW, cpc), ws_currentprices.Cells(COMMODITY_ROW, cpc ‑ 1), vbTextCompare) <> 0 Then
'Sort prior market data by date
If marketcount <> 0 Then
ws_oil.Range("A" & marketstartrow + 1 & ":FF" & r).Sort Key1:=ws_oil.Range("B" & marketstartrow + 1 & ":FF" & r), _
order1:=xlAscending, Header:=xlYes
End If
'Start each new market on row divisible by 30 + 1 to prevent any issues with summary table
marketstartrow = marketcount * 30 + 1
marketcount = marketcount + 1
r = marketstartrow
'Add labels for new market
ws_oil.Cells(r, YEARMONTH_COL) = ws_currentprices.Cells(COMMODITY_ROW, cpc)
ws_oil.Cells(r + 1, YEARMONTH_COL) = "YEARMONTH"
ws_oil.Cells(r + 1, DATE_COL) = "Date"
ws_oil.Cells(r + 1, SPOT_COL) = "Spot"
c = c + 3
For i = 0 To 59
ws_oil.Cells(r + 1, c + i) = i + 1
Next
r = r + 2
End If
'Populate date
ws_oil.Cells(r, DATE_COL) = ws_currentprices.Cells(ASOFDATE_ROW, cpc)
ws_oil.Cells(r, YEARMONTH_COL) = Year(ws_oil.Cells(r, DATE_COL)) & "." & Month(ws_oil.Cells(r, DATE_COL))
'Populate spot
ws_oil.Cells(r, SPOT_COL) = ws_currentprices.Cells(SPOT_ROW, cpc)
c = 4
'Populate row
Do Until cpr > 60 And IsEmpty(ws_currentprices.Cells(cpr, cpc))
ws_oil.Cells(r, c) = ws_currentprices.Cells(cpr, cpc)
cpr = cpr + 1
c = c + 1
Loop
r = r + 1
End If
cpc = cpc + 1
Loop
'Sort final market data by date
ws_oil.Range("A" & marketstartrow + 1 & ":FF" & r).Sort Key1:=ws_oil.Range("B" & marketstartrow + 1 & ":B" & r), _
order1:=xlAscending, Header:=xlYes
'Iterate through the Nymex data to update market index values
r = 2
index = 0
Do Until (IsEmpty(ws_oil.Cells(r, DATE_COL)))
If IsEmpty(ws_oil.Cells(r, DATE_COL + 2)) Then
'No value for current month, so take prior row value for index
Call UpdateIndexes(markettype, ws_oil.Cells(r ‑ 1, DATE_COL), ws_oil.Cells(r ‑ 1, DATE_COL + 2))
Exit Do
End If
r = r + 1
Loop
End Sub
Sub REFINEDSetup()
Dim cpr, cpc, r, c, marketcount, marketstartrow As Integer
Dim index As Double
Const YEARMONTH_COL = 1
Const DATE_COL = 2
Const SPOT_COL = 3
Const markettype = "REFINED"
ws_REFINED.UsedRange.ClearContents
cpc = FIRSTDATA_COL
marketcount = 0
marketstartrow = 0
'Loop through each column in currentprices looking for REFINED markets
Do Until (IsEmpty(ws_currentprices.Cells(COMMODITY_ROW, cpc)))
If StrComp(ws_currentprices.Cells(MARKETTYPE_ROW, cpc), markettype, vbTextCompare) = 0 Then
'This is a REFINED column
cpr = FIRSTDATE_ROW
c = 1
If StrComp(ws_currentprices.Cells(COMMODITY_ROW, cpc), ws_currentprices.Cells(COMMODITY_ROW, cpc ‑ 1), vbTextCompare) <> 0 Then
'Sort prior market data by date
If marketcount <> 0 Then
ws_REFINED.Range("A" & marketstartrow + 1 & ":FF" & r).Sort Key1:=ws_REFINED.Range("B" & marketstartrow + 1 & ":FF" & r), _
order1:=xlAscending, Header:=xlYes
End If
'Start each new market on row divisible by 30 + 1 to prevent any issues with summary table
marketstartrow = marketcount * 30 + 1
marketcount = marketcount + 1
r = marketstartrow
'Add labels for new market
ws_REFINED.Cells(r, YEARMONTH_COL) = ws_currentprices.Cells(COMMODITY_ROW, cpc)
ws_REFINED.Cells(r + 1, YEARMONTH_COL) = "YEARMONTH"
ws_REFINED.Cells(r + 1, DATE_COL) = "Date"
ws_REFINED.Cells(r + 1, SPOT_COL) = "Spot"
c = c + 3
For i = 0 To 59
ws_REFINED.Cells(r + 1, c + i) = i + 1
Next
r = r + 2
End If
'Populate date
ws_REFINED.Cells(r, DATE_COL) = ws_currentprices.Cells(ASOFDATE_ROW, cpc)
ws_REFINED.Cells(r, YEARMONTH_COL) = Year(ws_REFINED.Cells(r, DATE_COL)) & "." & Month(ws_REFINED.Cells(r, DATE_COL))
'Populate spot
ws_REFINED.Cells(r, SPOT_COL) = ws_currentprices.Cells(SPOT_ROW, cpc)
c = 4
'Populate row
Do Until cpr > 60 And IsEmpty(ws_currentprices.Cells(cpr, cpc))
ws_REFINED.Cells(r, c) = ws_currentprices.Cells(cpr, cpc)
cpr = cpr + 1
c = c + 1
Loop
r = r + 1
End If
cpc = cpc + 1
Loop
'Sort final market data by date
ws_REFINED.Range("A" & marketstartrow + 1 & ":FF" & r).Sort Key1:=ws_REFINED.Range("B" & marketstartrow + 1 & ":B" & r), _
order1:=xlAscending, Header:=xlYes
'Iterate through the Nymex data to update market index values
r = 2
index = 0
Do Until (IsEmpty(ws_REFINED.Cells(r, DATE_COL)))
If IsEmpty(ws_REFINED.Cells(r, DATE_COL + 2)) Then
'No value for current month, so take prior row value for index
Call UpdateIndexes(markettype, ws_REFINED.Cells(r ‑ 1, DATE_COL), ws_REFINED.Cells(r ‑ 1, DATE_COL + 2))
Exit Do
End If
r = r + 1
Loop
End Sub
リファレンスソリューション
方法 1:
StrComp in VBA does not return True or False. It returns ‑1, 0, or 1 depending on the results of the string comparison. If the two strings match for the particular type of comparison chosen then StrComp will return 0.
However, VBA treats 0 as being equivalent to False ‑ see here. This means that if you write a StrComp where the two strings match, but you forget to compare the results to zero, then you will get a result of False if you use the result as if it were a Boolean (e.g. in an If statement).
In your code, you have:
If (StrComp(ws_currentprices.Cells(COMMODITY_ROW, c), "GD Henry Hub", vbTextCompare) And Not gaschk) Then
If (StrComp(ws_currentprices.Cells(COMMODITY_ROW, c), "NYMEX WTI", vbTextCompare) And Not oilchk) Then
If (StrComp(ws_currentprices.Cells(COMMODITY_ROW, c), "OPIS Ethane Mt Belv non TET", vbTextCompare) And Not REFINEDchk) Then
All three statements are incorrectly using the result of StrComp as if it were a Boolean. Change all three to StrComp(...) = 0 instead